(use-modules (web server)
             (web request)
             (web response)
             (web uri)
             (sxml simple)
             (ice-9 regex))

;; this is probably not necessary.  I'd just have nginx serve these files
(define css-pattern  (make-regexp ".*css$"  regexp/extended))
(define js-pattern   (make-regexp ".*js$"   regexp/extended))
(define sxml-pattern (make-regexp ".*sxml$" regexp/extended))

(define (not-found request)
  (values (build-response #:code 404)
          (string-append "Resource not found: "
                         (uri->string (request-uri request))
                         " length is "
                         (number->string (string-length
                                          (uri->string
                                           (request-uri request)))))))

(define* (templatize title body #:optional style)
  `(html (head (title ,title)
               ,(when style
                  '(link (@ (rel "stylesheet") (href "style.css")
                            (type "text/css")))))
         (body ,@body)))

(define* (respond #:optional body #:key
                  (style #f)
                  (status 200)
                  (title "Upselling")
                  (doctype "<!DOCTYPE html>\n")
                  (content-type-params '((charset . "utf-8")))
                  (content-type 'text/html)
                  (extra-headers '())
                  (sxml (and body (templatize title body))))
  (values (build-response
           #:code status
           #:headers `((content-type
                        . (,content-type ,@content-type-params))
                       ,@extra-headers))
          (lambda (port)
            (if sxml
                (begin
                  (if doctype (display doctype port))
                  (sxml->xml sxml port))))))

(define (request-path-components request)
  (split-and-decode-uri-path (uri-path (request-uri request))))

(define (serve-page request body)
  (cond
   [(equal? (request-path-components request) '("hacker"))
    (respond
     #:sxml
     '((h1 "Upselling")
       (body
        (p "Hey there!"))
       (table
        (tr (th "header") (th "value"))
        ,@(map (lambda (pair)
                 `(tr (td (tt ,(with-output-to-string
                                 (lambda () (display (car pair))))))
                      (td (tt ,(with-output-to-string
                                 (lambda ()
                                   (write (cdr pair))))))))
               (request-headers request)))
       ))]
   [(equal? (request-path-components request) '("submit.scm"))
    (respond
     '((body (h1 "hello")))
     )
    ]
   ((equal? (request-path-components request) '("about"))
    (respond
     '((body
        (p "About")))))
   ((equal? (request-path-components request) '("contact"))
    (respond
     '((h1 "contact")
       (body
        (p "contact")))))
   ((equal? (string-length (uri->string (request-uri request))) 1)
    (respond
     #:style "style.css"
     #:sxml
     '((body
        (main (@ (class body))
             (div (@ (class "content"))
                  (h1 "Upselling")
                  (form (@ (action "/submit.scm")
                           (method "post"))
                        (ul
                         (li
                          (label (@ (for "confirmation"))
                                 "Confirmation #:")
                          (input (@ (type "text") (id "confirmation") (name "confirmation"))))
                         (li
                          (label (@ (for "los"))
                                 "Length of Stay:")
                          (input (@ (type "text") (id "los") (name "los")))
                          (input (@ (type "submit") (id "los") (name "los")))))))
             )))
     ))
   ;;The next three are probably not necessary.
   ;;I'll probably just have nginx serve these kinds of files
   ((regexp-exec css-pattern (uri->string (request-uri request)))
    (values (build-response)
            "style.css file content goes here."))
   ((regexp-exec js-pattern (uri->string (request-uri request)))
    (values (build-response)
            "javascript.js file content goes here."))
   ((regexp-exec sxml-pattern (uri->string (request-uri request)))
    (values (build-response)
            "sxml->xml is run on file content."))
   (else (not-found request))))

(run-server serve-page)

;; building URIs
;; (uri->string
;;  (build-uri 'http #:host "www.gnu.org"
;;             #:port 55
;;             #:path "/documentation/emacs/index.scm"
;;             #:query "hello=5"
;;             #:fragment "cool-spot"
;;             ))
